home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1997
/
MacHack 1997.toast
/
Hacks
/
Hacks ’94
/
[√] Distribution Restricted!
/
Christian Ruse
/
Fourier Paper + Apps
/
nih-image154_source.sea
/
V1.54 Source
/
Image.p
< prev
next >
Wrap
Text File
|
1994-02-01
|
70KB
|
2,688 lines
program Image;
{NIH Image is a public domain program for the Macintosh for acquiring, }
{enhancing, analyzing, editing, printing, and animating 8-bit images.}
{Version 1.54, 1 Feb 1994}
{Developed using Think Pascal 4.0.1}
{Note: requires at least a 5MB partition for Think Pascal.}
{Author :}
{Wayne Rasband}
{National Institutes of Health}
{Internet: wayne@helix.nih.gov}
{Anonymous ftp: zippy.nimh.nih.gov}
{Phone: 301-496-4957}
uses
QuickDraw, Palettes, PrintTraps, Globals, Utilities, Initialization, File1, File2, Analysis, Graphics, {}
Edit, Filters, Camera, User, Macros1, Macros2, Stacks, Background, {,UMacroDef, UMacroRun}
Lut, Projection, Plugins, Text, Math;
{Turn off automatic toolbox initialization.}
{$I-}
{PROCEDURE MacsBug; inline $a9ff;}
procedure UpdateOptionsMenu;
var
CheckIt: boolean;
i: integer;
begin
with info^ do begin
CheckItem(OptionsMenuH, GrayscaleItem, (LutMode = Grayscale) or (LutMode = CustomGrayscale));
if LutMode <> PseudoColor then
ColorTable := CustomTable;
CheckItem(ColorTablesMenuH, SystemPaletteItem, ColorTable = AppleDefault);
CheckItem(ColorTablesMenuH, Pseudo20Item, ColorTable = Pseudo20);
CheckItem(ColorTablesMenuH, Pseudo32Item, ColorTable = Pseudo32);
CheckItem(ColorTablesMenuH, RainbowItem, ColorTable = Rainbow);
CheckItem(ColorTablesMenuH, Fire1Item, ColorTable = Fire1);
CheckItem(ColorTablesMenuH, Fire2Item, ColorTable = Fire2);
CheckItem(ColorTablesMenuH, IceItem, ColorTable = Ice);
CheckItem(ColorTablesMenuH, GraysItem, ColorTable = Grays);
CheckItem(ColorTablesMenuH, SpectrumItem, ColorTable = Spectrum);
SetMenuItem(OptionsMenuH, ScaleToFitItem, info <> NoInfo);
CheckIt := ScaleToFitWindow;
CheckItem(OptionsMenuH, ScaleToFitItem, CheckIt);
CheckItem(OptionsMenuH, ThresholdItem, Thresholding);
CheckItem(OptionsMenuH, SliceItem, DensitySlicing);
SetMenuItem(OptionsMenuH, PropagateItem, nPics > 1);
end;
end;
procedure UpdateEnhanceMenu;
var
ShowItems: boolean;
i: integer;
str: str255;
begin
ShowItems := Info <> NoInfo;
for i := SmoothItem to FilterItem do
SetMenuItem(EnhanceMenuH, i, ShowItems);
with info^ do
if (LutMode = GrayScale) or (LutMode = CustomGrayscale) or DensitySlicing then
SetItem(EnhanceMenuH, ApplyItem, 'Apply LUT')
else
SetItem(EnhanceMenuH, ApplyItem, 'Convert to Grayscale');
if CurrentWindow = TextKind then
SetItem(EnhanceMenuH, ConvolveItem, 'Convolve')
else
SetItem(EnhanceMenuH, ConvolveItem, 'Convolve…');
for i := BinaryItem to FixColorsItem do
SetMenuItem(EnhanceMenuH, i, ShowItems);
NumToString(BinaryCount, str);
str := concat('Set Count[', str, ']…');
SetItem(BinaryMenuH, SetCountItem, str);
NumToString(BinaryIterations, str);
str := concat('Set Iterations[', str, ']…');
SetItem(BinaryMenuH, IterationsItem, str);
CheckItem(BackgroundMenuH, FasterItem, FasterBackgroundSubtraction);
NumToString(BallRadius, str);
str := concat('Set Radius[', str, ']…');
SetItem(BackgroundMenuH, RadiusItem, str);
end;
procedure UpdateSpecialMenu;
var
ShowItems: boolean;
begin
ShowItems := Info <> NoInfo;
SetMenuItem(SpecialMenuH, SaveBlankFieldItem, ShowItems);
SetMenuItem(SpecialMenuH, PhotoModeItem, ShowItems);
if CurrentWindow = TextKind then
SetItem(SpecialMenuH, LoadMacrosItem, 'Load Macros from Window')
else
SetItem(SpecialMenuH, LoadMacrosItem, 'Load Macros…')
end;
procedure UpdateStacksMenu;
var
ShowItems: boolean;
isStack: boolean;
begin
ShowItems := Info <> NoInfo;
SetMenuItem(StacksMenuH, StackFromWindowsItem, nPics > 0);
isStack := info^.StackInfo <> nil;
SetMenuItem(StacksMenuH, WindowsFromStackItem, isStack);
SetMenuItem(StacksMenuH, AddSliceItem, isStack);
SetMenuItem(StacksMenuH, DeleteSliceItem, isStack);
SetMenuItem(StacksMenuH, NextSliceItem, isStack);
SetMenuItem(StacksMenuH, PreviousSliceItem, isStack);
SetMenuItem(StacksMenuH, MakeMovieItem, ShowItems);
SetMenuItem(StacksMenuH, CaptureFramesItem, ShowItems);
SetMenuItem(StacksMenuH, AnimateItem, isStack);
SetMenuItem(StacksMenuH, AverageSlicesItem, isStack);
SetMenuItem(StacksMenuH, MakeMontageItem, isStack);
SetMenuItem(StacksMenuH, CaptureColorItem, ShowItems);
SetMenuItem(StacksMenuH, RGBToColorItem, isStack);
SetMenuItem(StacksMenuH, ColorToRGBItem, ShowItems and (not isStack));
SetMenuItem(StacksMenuH, RGBToHSVItem, isStack);
SetMenuItem(StacksMenuH, ProjectItem, isStack);
SetMenuItem(StacksMenuH, ResliceItem, isStack);
SetMenuItem(StacksMenuH, ResliceOptionsItem, isStack);
end;
function AboutFilter (d: DialogPtr; var event: EventRecord; var ItemHit: integer): boolean;
{ simple filter proc for about box -- must be at top level! % }
begin
if (event.what in [MouseDown, KeyDown, AutoKey]) then begin
AboutFilter := true;
ItemHit := OK;
end
else begin
AboutFilter := false;
ItemHit := 0;
end;
end;
procedure AboutUProc (d: DialogPtr; item: integer);
{ About box user proc -- must be at top level!}
var
s: str255;
saveport: grafptr;
VersInfo: str255;
begin
getport(saveport);
setport(d);
if (item = MemItem) then begin
NumToString(FreeMem div 1024, s);
s := concat(s, 'K free');
DrawSItem(MemItem, Geneva, 9, d, s);
end
else if (item = VersItem) then begin
RealToString(version / 100.0, 4, 2, VersInfo);
VersInfo := concat('Version ', VersInfo);
DrawSItem(VersItem, Geneva, 9, d, VersInfo);
end;
setport(saveport);
end;
procedure DoAbout;
{About Box by David Powell}
var
i: integer;
d: dialogptr;
midscreen: point;
r: rect;
h: handle;
itype: integer;
begin
d := getnewdialog(AboutID, nil, pointer(-1));
if (d <> nil) then begin
SetPort(d);
GetDItem(d, VersItem, itype, h, r);
SetDItem(d, VersItem, itype, @AboutUProc, r);
GetDItem(d, MemItem, itype, h, r);
SetDItem(d, MemItem, itype, @AboutUProc, r);
ShowWindow(d);
repeat
ModalDialog(@aboutfilter, i);
until (i = OK);
DisposDialog(d);
FlushEvents(EveryEvent, 0);
end;
end;
procedure DoPreferences;
const
BufferSizeID = 4;
ScaleArithmeticID = 6;
ScaleConvolutionsID = 7;
InvertValuesID = 8;
InvertYID = 9;
LW6ID = 10;
SwitchingID = 11;
HighlightID = 12;
CreatorID = 14;
var
mylog: DialogPtr;
item, i: integer;
SaveScale, SaveLW6, SaveScaleC: boolean;
SaveInvertValues, SaveInvertY: boolean;
SaveBufferSize: LongInt;
SaveCreator: packed array[1..4] of char;
begin
InitCursor;
SaveBufferSize := BufferSize;
SaveScale := ScaleArithmetic;
SaveInvertY := InvertYCoordinates;
SaveLW6 := DriverHalftoning;
SaveScaleC := ScaleConvolutions;
SaveCreator := TextCreator;
mylog := GetNewDialog(6000, nil, pointer(-1));
SetDNum(MyLog, BufferSizeID, BufferSize div 1024);
SetDialogItem(mylog, ScaleArithmeticID, ord(ScaleArithmetic));
SetDialogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions));
SetDialogItem(mylog, InvertYID, ord(InvertYCoordinates));
SetDialogItem(mylog, LW6ID, ord(not DriverHalftoning));
SetDialogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend));
SetDialogItem(mylog, HighlightID, ord(HighlightMode));
SaveInvertValues := InvertPixelValues;
if InvertPixelValues then
SetDialogItem(mylog, InvertValuesID, 1);
SetDString(mylog, CreatorID, TextCreator);
repeat
ModalDialog(nil, item);
if item = BufferSizeID then begin
BufferSize := GetDNum(MyLog, BufferSizeID) * 1024;
if BufferSize < 1 then begin
beep;
BufferSize := 1;
SetDNum(MyLog, BufferSizeID, BufferSize);
end;
end;
if item = ScaleArithmeticID then begin
ScaleArithmetic := not ScaleArithmetic;
SetDialogItem(mylog, ScaleArithmeticID, ord(ScaleArithmetic));
if PasteControl <> nil then
DrawPasteControl
end;
if item = ScaleConvolutionsID then begin
ScaleConvolutions := not ScaleConvolutions;
SetDialogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions));
end;
if item = InvertValuesID then begin
InvertPixelValues := not InvertPixelValues;
SetDialogItem(mylog, InvertValuesID, ord(InvertPixelValues));
end;
if item = InvertYID then begin
InvertYCoordinates := not InvertYCoordinates;
SetDialogItem(mylog, InvertYID, ord(InvertYCoordinates));
end;
if item = LW6ID then begin
DriverHalftoning := not DriverHalftoning;
SetDialogItem(mylog, LW6ID, ord(not DriverHalftoning));
end;
if item = SwitchingID then begin
SwitchLUTOnSuspend := not SwitchLUTOnSuspend;
SetDialogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend));
end;
if item = HighlightID then begin
HighlightMode := not HighlightMode;
SetDialogItem(mylog, HighlightID, ord(HighlightMode));
LoadLUT(info^.ctable);
end;
if item = CreatorID then
TextCreator := GetDString(mylog, item);
until (item = ok) or (item = cancel);
DisposDialog(mylog);
if item = cancel then begin
BufferSize := SaveBufferSize;
ScaleArithmetic := SaveScale;
ScaleConvolutions := SaveScaleC;
InvertYCoordinates := SaveInvertY;
DriverHalftoning := SaveLW6;
if PasteControl <> nil then
DrawPasteControl;
TextCreator := SaveCreator;
end
else
with info^ do begin
if InvertPixelValues and (SaveInvertValues = false) then
InvertgrayLevels
else if (InvertPixelValues = false) and SaveInvertValues then begin
DensityCalibrated := false;
DrawLabels('', '', '');
end;
UpdateTitleBar;
end;
if BufferSize <> SaveBufferSIze then
PutMessage('You must "Record Preferences" and restart before the Undo and Clipboard buffer size change will take effect.');
end;
procedure UpdateWindowsMenu;
var
i, n: integer;
begin
for i := NextImageItem to TileImagesItem do
SetMenuItem(WindowsMenuH, i, nPics > 1);
for i := SelectToolsItem to SelectResultsItem do
CheckItem(WindowsMenuH, i, false);
SetMenuItem(WindowsMenuH, SelectHistogramItem, HistoWindow <> nil);
SetMenuItem(WindowsMenuH, SelectPlotItem, PlotWindow <> nil);
SetMenuItem(WindowsMenuH, SelectResultsItem, ResultsWindow <> nil);
for i := 1 to nTextWindows do
CheckItem(WindowsMenuH, WindowsMenuItems - 1 + i, false);
for i := 1 to nPics do
CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + i, false);
if PasteControl = nil then
SetItem(WindowsMenuH, PasteControlItem, 'Show Paste Control')
else
SetItem(WindowsMenuH, PasteControlItem, 'Hide Paste Control');
if CurrentKind < 0 then
exit(UpdateWindowsMenu); {System Window}
case CurrentKind of
ToolKind:
CheckItem(WindowsMenuH, SelectToolsItem, true);
MapKind:
CheckItem(WindowsMenuH, SelectGrayMapItem, true);
LUTKind:
CheckItem(WindowsMenuH, SelectLutItem, true);
ValuesKind:
CheckItem(WindowsMenuH, SelectValuesItem, true);
HistoKind:
CheckItem(WindowsMenuH, SelectHistogramItem, true);
ProfilePlotKind, CalibrationPLotKind:
CheckItem(WindowsMenuH, SelectPlotItem, true);
ResultsKind:
CheckItem(WindowsMenuH, SelectResultsItem, true);
TextKind: begin
if TextInfo <> nil then
CheckItem(WindowsMenuH, WindowsMenuItems - 1 + TextInfo^.WindowNum, true);
end;
PicKind:
CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + info^.PicNum, true);
otherwise
end;
end;
procedure CloseAll;
FORWARD;
procedure DoNew;
const
ImageID = 4;
TextID = 5;
WidthID = 6;
HeightID = 7;
TitleID = 8;
var
mylog: DialogPtr;
item, i: integer;
SaveWidth, SaveHeight: integer;
SaveTitle: string[31];
okay, OpenImage: boolean;
procedure SetButtons;
begin
SetDialogItem(mylog, ImageID, ord(OpenImage));
SetDialogItem(mylog, TextID, ord(not OpenImage));
end;
begin
InitCursor;
OpenImage := true;
SaveWidth := NewPicWidth;
SaveHeight := NewPicHeight;
SaveTitle := NewTitle;
mylog := GetNewDialog(180, nil, pointer(-1));
SetButtons;
SetDNum(MyLog, WidthID, NewPicWidth);
SelIText(MyLog, WidthID, 0, 32767);
SetDNum(MyLog, HeightID, NewPicHeight);
SetDString(MyLog, TitleID, NewTitle);
repeat
ModalDialog(nil, item);
if item = ImageID then begin
OpenImage := true;
SetButtons;
end;
if item = TextID then begin
OpenImage := false;
SetButtons;
end;
if item = WidthID then begin
NewPicWidth := GetDNum(MyLog, WidthID);
if (NewPicWidth < 0) or (NewPicWidth > MaxPicSize) then begin
NewPicWidth := SaveWidth;
SetDNum(MyLog, WidthID, NewPicWidth);
end;
end;
if item = HeightID then begin
NewPicHeight := GetDNum(MyLog, HeightID);
if (NewPicHeight < 0) or (NewPicHeight > MaxPicSize) then begin
NewPicHeight := SaveHeight;
SetDNum(MyLog, HeightID, NewPicHeight);
end;
end;
until (item = ok) or (item = cancel);
if item = ok then
NewTitle := GetDString(MyLog, TitleID);
DisposDialog(mylog);
if NewPicWidth < 32 then
NewPicWidth := 32;
if odd(NewPicWidth) then
NewPicWidth := NewPicWidth + 1;
if NewPicHeight < 16 then
NewPicHeight := 16;
if item = cancel then begin
NewPicWidth := SaveWidth;
NewPicHeight := SaveHeight;
NewTitle := SaveTitle;
exit(DoNew);
end;
if OpenImage then begin
okay := NewPicWindow(NewTitle, NewPicWidth, NewPicHeight);
if okay then
if info^.PixMapSize > UndoBufSize then
PutWarning;
end
else
okay := MakeNewTextWindow(NewTitle, 500, 400);
end;
procedure DoMenuEvent (MenuChoice: LongInt);
var
MenuID, MenuItem, i, ignore: integer;
name, str: str255;
dna, RefNum: integer;
ItemName: str255;
FontName: str255;
ok, isSelection: boolean;
NewStyle: StyleItem;
t: FateTable; {Only needed for MakeSkeleton}
SaveBFInfo: InfoPtr;
begin
MenuID := HiWord(MenuChoice);
MenuItem := LoWord(MenuChoice);
case MenuID of
AppleMenu: begin
if MenuItem = 1 then
DoAbout
else begin
GetItem(GetMHandle(AppleMenu), MenuItem, name);
ignore := OpenDeskAcc(name)
end;
end;
FileMenu: begin
StopDigitizing;
isInsertionPoint := false;
case MenuItem of
NewItem:
DoNew;
OpenItem:
ok := DoOpen('', 0);
ImportItem:
ok := ImportFile('', 0);
{-}
CloseItem:
if OptionKeyWasDown and (CurrentWindow <> TextKInd) then
CloseAll
else
DoClose;
SaveItem:
if OptionKeyWasDown and (info^.StackInfo = nil) and (CurrentWindow <> TextKind) then
SaveAll
else
SaveFile;
SaveAsItem:
case CurrentWindow of
TextKind:
SaveTextAs;
ResultsKind:
Export('', 0);
otherwise
SaveAs('', 0);
end;
ExportItem:
Export('', 0);
SaveScreenItem:
SaveScreen;
{-}
RecordPreferencesItem:
SaveSettings;
RevertItem:
with info^ do
if DataType = EightBits then
RevertToSaved
else
RescaleToEightBits;
DuplicateItem:
ok := Duplicate('', false);
GetInfoItem:
GetInfo;
{-}
SetHalftoneItem:
SetHalftone;
PageSetupItem:
DoPageSetup;
PrintItem:
Print(true);
{-}
QuitItem:
finished := true;
end;
end;
AcquireMenu:
RunAcqPlugIn(MenuItem);
ExportMenu:
RunExportPlugIn(MenuItem);
EditMenu: begin
StopDigitizing;
GetItem(GetMHandle(EditMenu), MenuItem, ItemName);
if not SystemEdit(MenuItem - 1) then
case MenuItem of
UndoItem:
DoUndo;
{-}
CutItem:
DoCut;
CopyItem:
DoCopy;
PasteItem:
DoPaste;
ClearItem:
DoClear;
{-}
FillItem:
if CurrentWindow = TextKind then
DoFind
else
SetupOperation(FillItem);
InvertItem, DrawBoundaryItem:
SetupOperation(MenuItem);
DrawScaleItem:
DrawScale;
{-}
SelectAllItem:
with info^ do
if RoiShowing and EqualRect(RoiRect, PicRect) then
KillRoi
else
SelectAll(true);
ScaleAndRotateItem:
ScaleAndRotate;
{-}
RotateLeftItem:
Rotate(RotateLeft);
RotateRightItem:
Rotate(RotateRight);
FlipVerticalItem:
FlipOrRotate(FlipVertical);
FlipHorizontalItem:
FlipOrRotate(FlipHorizontal);
{-}
UnzoomItem:
Unzoom;
ShowClipboardItem:
ShowClipboard;
end;
end;
OptionsMenu: begin
case MenuItem of
GrayscaleItem:
ResetGrayMap;
LutOptionsItem:
DoLutOptions;
{-}
PreferencesItem:
DoPreferences;
PlotOptionsItem:
DoProfilePlotOptions;
ScaleToFitItem:
ScaleToFit;
ThresholdItem: begin
if DensitySlicing then
DisableDensitySlice;
if Info^.Thresholding then
DisableThresholding
else begin
SetupLutUndo;
AutoThreshold;
end;
end;
SliceItem:
if DensitySlicing then
DisableDensitySlice
else begin
if info^.thresholding then
DisableThresholding;
EnableDensitySlice;
end;
end;
end;
ColorTablesMenu:
SwitchColorTables(MenuItem, true);
FontMenu: begin
GetItem(FontMenuH, MenuItem, FontName);
GetFNum(FontName, CurrentFontID);
DisplayText(true);
if CurrentWindow = TextKind then
ChangeFontOrSize;
end;
SizeMenu: begin
case MenuItem of
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12:
CurrentSize := GetFontSize(MenuItem);
end;
DisplayText(true);
if IsInsertionPoint then
UpdatePicWindow;
if CurrentWindow = TextKind then
ChangeFontOrSize;
end;
StyleMenu: begin
case MenuItem of
1:
CurrentStyle := [];
2, 3, 4, 5, 6: begin
case MenuItem of
TxBold:
NewStyle := Bold;
TxItalic:
NewStyle := Italic;
TxUnderLine:
NewStyle := Underline;
TxOutLine:
NewStyle := Outline;
TxShadow:
NewStyle := Shadow;
end;
if NewStyle in CurrentStyle then
CurrentStyle := CurrentStyle - [NewStyle]
else
CurrentStyle := CurrentStyle + [NewStyle];
end;
LeftItem:
TextJust := teJustLeft;
CenterItem:
TextJust := teJustCenter;
RightItem:
TextJust := teJustRight;
NoBackgroundItem:
TextBack := NoBack;
WithBackgroundItem:
TextBack := WithBack;
end; {case}
DisplayText(true);
end;
PropagateMenu:
DoPropagate(MenuItem);
EnhanceMenu: begin
StopDigitizing;
SetupUndo;
case MenuItem of
SmoothItem:
if OptionKeyDown then
Filter(UnweightedAvg, 0, t)
else
Filter(WeightedAvg, 0, t);
SharpenItem:
Filter(fsharpen, 0, t);
ShadowItem:
Filter(fshadow, 0, t);
EdgeDetectItem:
Filter(EdgeDetect, 0, t);
ReduceNoiseItem:
Filter(ReduceNoise, 0, t);
DitherItem:
Filter(Dither, 0, t);
ConvolveItem:
if CurrentWindow = TextKind then
ConvolveUsingText
else
Convolve('', 0);
{-}
ImageMathItem:
DoImageMath;
ApplyItem:
ApplyLookupTable;
EnhanceItem:
EnhanceContrast;
EqualizeItem:
EqualizeHistogram;
FixColorsItem:
FixColors;
end;
end;
FilterMenu:
RunFilterPlugin(menuItem);
BinaryMenu:
case MenuItem of
MakeBinaryItem:
MakeBinary;
ErosionItem:
DoErosion;
DilationItem:
DoDilation;
OpeningItem:
DoOpening;
ClosingItem:
DoClosing;
SetCountItem:
SetBinaryCount;
IterationsItem:
SetIterations;
OutlineItem:
filter(OutlineFilter, 0, t);
SkeletonizeItem:
MakeSkeleton;
end;
ArithmeticMenu:
DoArithmetic(MenuItem, 0);
BackgroundMenu:
DoBackgroundMenuEvent(MenuItem);
AnalyzeMenu: begin
if MenuItem <> HistogramItem then
StopDigitizing;
SetupUndo;
case MenuItem of
MeasureItem:
Measure;
AnalyzeItem:
AnalyzeParticles;
ShowItem:
ShowResults;
OptionsItem:
DoMeasurementOptions;
HistogramItem:
DoHistogram;
PlotItem:
PlotDensityProfile;
PlotSurfaceItem:
PlotSurface;
{-}
SetScaleItem:
SetScale;
CalibrateItem:
Calibrate;
RedoItem:
RedoMeasurement;
DeleteItem:
DeleteMeasurement;
ResetItem:
ResetCounter;
RestoreItem:
RestoreRoi;
MarkItem:
MarkSelection(mCount);
end;
end;
SpecialMenu: begin
case MenuItem of
StartItem:
StartDigitizing;
AverageItem:
AverageFrames;
SaveBlankFieldItem: begin
SaveBFInfo := BlankFieldInfo;
BlankFieldInfo := nil; {Prevents shading correction.}
StopDigitizing;
BlankFieldInfo := SaveBFInfo;
SaveBlankField;
end;
VideoControlItem:
if VideoControl = nil then
ShowVideoControl
else
SelectWindow(VideoControl);
PhotoModeItem:
PhotoMode;
LoadMacrosItem: begin
LoadMacros;
UnloadSeg(@LoadMacros)
end;
otherwise
if MenuItem >= FirstMacroItem then
RunMacro(MenuItem - FirstMacroItem + 1);
end;
end;
StacksMenu: begin
StopDigitizing;
case MenuItem of
StackFromWindowsItem:
MakeStack;
WindowsFromStackItem:
MakeWindowsFromStack;
AddSliceItem:
ok := AddSlice(true);
DeleteSliceItem:
DeleteSlice;
NextSliceItem, PreviousSliceItem:
ShowNextSlice(MenuItem);
MakeMovieItem:
MakeMovie;
CaptureFramesItem:
CaptureFrames;
AnimateItem:
Animate;
AverageSlicesItem:
AverageSlices;
MakeMontageItem:
MakeMontage;
CaptureColorItem:
CaptureColor;
RGBToColorItem:
ConvertRGBToEightBitColor(false);
ColorToRGBItem:
ConvertEightBitColorToRGB;
RGBToHSVItem:
ConvertRGBToHSV;
ProjectItem:
Project;
ResliceItem:
Reslice;
ResliceOptionsItem:
DoResliceOptions;
otherwise
beep
end;
end;
WindowsMenu: begin
if MenuItem <> PasteControlItem then
StopDigitizing;
case MenuItem of
NextImageItem:
ShowNextImage;
StackImagesItem:
StackImages;
TileImagesItem:
TileImages;
PasteControlItem:
if PasteControl = nil then
ShowPasteControl
else
ignore := CloseAWindow(PasteControl);
{-}
SelectToolsItem:
SelectWindow(ToolWindow);
SelectGrayMapItem:
SelectWindow(MapWindow);
SelectLutItem:
SelectWindow(LUTWindow);
SelectValuesItem:
SelectWindow(ValuesWindow);
SelectHistogramItem:
if HistoWindow <> nil then
SelectWindow(HistoWindow);
SelectPlotItem:
if PlotWindow <> nil then
SelectWindow(PlotWindow);
SelectResultsItem:
if ResultsWindow <> nil then
SelectWindow(ResultsWindow);
{-}
otherwise
if MenuItem <= (WindowsMenuItems - 1 + nTextWindows) then
SelectWindow(TextWindow[MenuItem - (WindowsMenuItems - 1)])
else
SelectWindow(PicWindow[MenuItem - (WindowsMenuItems + nTextWindows)]);
end;
end;
UserMenu:
DoUserMenuEvent(MenuItem);
otherwise
end;
HiliteMenu(0);
RoiUpdateTime := 0;
end;
procedure DoFreehand;
var
finish: point;
event: EventRecord;
wright, wbottom: integer;
b: boolean;
begin
SetPort(info^.wptr);
PenPat(pat[PatIndex]);
PenSize(1, 1);
with info^.wptr^.PortRect do begin
wright := right;
wbottom := bottom;
end;
while Button do begin
GetMouse(finish);
with finish do begin
if h < 0 then
h := 0;
if v < 0 then
v := 0;
if h > wright then
h := wright;
if v > wbottom then
v := wbottom;
if (xCoordinates^[nCoordinates] <> h) or (yCoordinates^[nCoordinates] <> v) then begin
if nCoordinates < MaxCoordinates then
nCoordinates := nCoordinates + 1
else
beep;
LineTo(h, v);
xCoordinates^[nCoordinates] := h;
yCoordinates^[nCoordinates] := v;
wait(1);
end; {if mouse has moved}
end; {with}
end; {while Button}
end;
procedure DoPolygon (start: point);
var
Finish, OldFinish: point;
finished, DoubleClick, done: boolean;
ticks, MouseUpTime, LastMouseUpTime: LongInt;
wright, wbottom: integer;
StartRect: rect;
MouseDown, MouseUpEvent: boolean;
begin
DrawLabels('DX:', 'DY:', 'Length:');
SetPort(info^.wptr);
PenMode(PatXor);
PenSize(1, 1);
if CurrentTool = PolygonTool then begin
Pt2Rect(Start, Start, StartRect);
InsetRect(StartRect, -4, -4);
FrameRect(StartRect);
end
else
SetRect(StartRect, 0, 0, 0, 0);
finish := start;
finished := false;
with info^.wptr^.PortRect do begin
wright := right;
wbottom := bottom;
end;
MouseUpTime := 0;
done := false;
MouseUpEvent := false;
MouseDown := button;
repeat
ShowDxDy(0, 0);
repeat
OldFinish := finish;
GetMouse(finish);
with finish do begin
if h < 0 then begin
h := 0;
done := CurrentTool = LineTool;
end;
if v < 0 then begin
v := 0;
done := CurrentTool = LineTool;
end;
if h > wright then begin
h := wright;
done := CurrentTool = LineTool;
end;
if v > wbottom then begin
v := wbottom;
done := CurrentTool = LineTool;
end;
end;
if not EqualPt(finish, OldFinish) then begin
ticks := TickCount;
repeat
until TickCount <> ticks;
MoveTo(start.h, start.v);
LineTo(OldFinish.h, OldFinish.v);
MoveTo(start.h, start.v);
LineTo(finish.h, finish.v);
ShowDxDy(abs(finish.h - start.h), abs(finish.v - start.v));
end;
if button <> MouseDown then begin
MouseUpEvent := not button;
MouseDown := button;
end;
until MouseUpEvent;
MouseUpEvent := false;
LastMouseUpTime := MouseUpTime;
MouseUpTime := TickCount;
DoubleClick := ((MouseUpTime - LastMouseUpTime) < GetDblTime) and EqualPt(start, finish);
if nCoordinates < MaxCoordinates then
nCoordinates := nCoordinates + 1
else
beep;
xCoordinates^[nCoordinates] := finish.h;
yCoordinates^[nCoordinates] := finish.v;
start := finish;
Finished := (PtInRect(finish, StartRect) or DoubleClick or done) and (nCoordinates > 2);
until finished;
FlushEvents(EveryEvent, 0);
end;
procedure MakePolygon (event: EventRecord);
var
Start: point;
i: integer;
begin
with info^ do begin
start := event.where;
SetPort(wptr);
PenNormal;
xCoordinates^[1] := Start.h;
yCoordinates^[1] := Start.v;
nCoordinates := 1;
MoveTo(start.h, start.v);
case CurrentTool of
FreehandTool: begin
DoFreehand;
with Start do
LineTo(h, v);
end;
PolygonTool:
DoPolygon(start);
end;
if nCoordinates > 2 then begin
ConvertCoordinates;
if CurrentTool = PolygonTool then
MakeOutline(PolygonRoi)
else
MakeOutline(FreehandRoi);
end
else begin
KillRoi;
UpdatePicWindow;
end;
end; {with}
end;
procedure MakeLineRoi (event: EventRecord);
var
Start: point;
begin
start := event.where;
with Info^ do begin
if PixMapSize > UndoBufSize then begin
beep;
exit(MakeLineRoi);
end;
WhatToUndo := NothingToUndo;
measuring := false;
if LOIType = Straight then begin
DoObject(LineObj, event);
RoiType := LineRoi;
MakeRegion;
RoiShowing := true;
SetupUndo;
exit(MakeLineRoi);
end;
SetPort(wptr);
PenNormal;
MoveTo(start.h, start.v);
xCoordinates^[1] := Start.h;
yCoordinates^[1] := Start.v;
nCoordinates := 1;
end; {with info}
if LOIType = Freehand then
DoFreehand
else
DoPolygon(start);
if nCoordinates > 1 then
case LoiType of
freehand:
MakeNonStraightLineRoi(FreeLineRoi);
segmented:
MakeNonStraightLineRoi(SegLineRoi);
end
else
with info^ do begin
RoiShowing := false;
RoiType := NoRoi;
UpdatePicWindow;
end;
end;
procedure DoProfilePlot (event: EventRecord);
var
ulength, clength: real;
begin
with Info^ do begin
WhatToUndo := NothingToUndo;
measuring := false;
DoObject(LineObj, event);
RoiType := LineRoi;
MakeRegion;
RoiShowing := true;
SetupUndo;
GetLengthOrPerimeter(ulength, clength);
if ulength > 0 then
PlotDensityProfile
end;
end;
procedure DoMouseDownInWindow (event: EventRecord; WhichWindow: WindowPtr);
{Handles mouse down events in the content region of image windows.}
var
r: rect;
str: str255;
hloc, vloc: integer;
tool: ToolType;
start: Point;
begin
if (WindowPeek(WhichWindow)^.WindowKind <> PicKind) then
exit(DoMouseDownInWindow);
SetPort(info^.wptr);
if Digitizing then
if (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) then
StopDigitizing;
GlobalToLocal(event.where);
IsInsertionPoint := false;
with info^ do
if RoiShowing then
if EqualRect(RoiRect, PicRect) and (SelectionMode = NewSelection) then {if Select All}
if not (OpPending and (CurrentOp = PasteOp)) then begin
KillRoi;
MouseState := NotInRoi;
exit(DoMouseDownInWindow);
end;
if MouseState <> NotInRoi then
exit(DoMouseDownInWindow);
if SpaceBarDown and (CurrentTool <> TextTool) then
tool := grabber
else
tool := CurrentTool;
if (SelectionMode = NewSelection) and not ((tool = MagnifyingGlass) or (tool = Grabber)) then
KillRoi;
SetupUndo;
case tool of
SelectionTool:
DoObject(SelectionRect, event);
PolygonTool, FreehandTool:
MakePolygon(event);
OvalSelectionTool:
DoObject(SelectionOval, event);
LineTool:
MakeLineRoi(event);
MagnifyingGlass:
ZoomIn(event);
Grabber:
Scroll(event);
Pencil, Brush, Eraser:
DoBrush(event);
SprayCanTool:
DoSprayCan;
Ruler:
if OptionKeyDown or ControlKeyDown then
PutMessage('Use the line selection tool and Measure to measure path lengths.')
else begin
DoObject(LineObj, event);
WhatToUndo := UndoEdit;
end;
PaintBucket:
DoFill(event);
TextTool:
DoText(event.where);
PlotTool:
DoProfilePlot(event);
PickerTool:
if BitAnd(Event.modifiers, OptionKey) = OptionKey then
GetBackgroundColor(event)
else
GetForegroundColor(event);
CrossHairTool:
DoPoints(event);
AngleTool:
FindAngle(event);
Wand: begin
if Digitizing then
StopDigitizing;
start := event.where;
ScreenToOffscreen(start);
AutoOutline(start);
end;
otherwise
beep;
end;
end;
procedure DoPopupMenusInTools;
var
Item: integer;
ticks: LongInt;
procedure DrawCurrentTool;
begin
InvalRect(ToolRect[CurrentTool]);
BeginUpdate(ToolWindow);
DrawTools;
EndUpdate(ToolWindow);
end;
begin
DrawCurrentTool;
ticks := TickCount;
repeat
until (not button) or (TickCount > ticks + 20);
if button and (TickCount > (ticks + 20)) then
with ToolRect[CurrentTool] do begin
Item := PopUpMenu(LineToolMenuH, left, top, ord(LOIType) + 1);
case Item of
1:
LOIType := Straight;
2:
LOIType := Freehand;
3:
LOIType := Segmented;
otherwise
end;
DrawCurrentTool;
end;
end;
procedure DoMouseDownInTools (loc: point);
{Handles mouse down events in the tool palette.}
var
r: rect;
OddTool, DoubleClick: boolean;
ToolNum, i: integer;
begin
SetPort(ToolWindow);
GlobalToLocal(loc);
if loc.v <= StartOfLines then begin
PreviousTool := CurrentTool;
OddTool := loc.h < tmiddle;
ToolNum := (loc.v div tmiddle) * 2;
if not OddTool then
ToolNum := ToolNum + 1;
CurrentTool := ToolType(ToolNum);
isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool) or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = LineTool);
DoubleClick := (TickCount - ToolTime) < GetDblTime;
ToolTime := TickCount;
InvalRect(ToolRect[CurrentTool]);
InvalRect(ToolRect[PreviousTool]);
IsInsertionPoint := false;
if DoubleClick and (CurrentTool = PreviousTool) then
case CurrentTool of
MagnifyingGlass:
Unzoom;
SelectionTool: begin
StopDigitizing;
SelectAll(true);
end;
SprayCanTool:
SetSprayCanSize;
Brush:
SetBrushSize;
LineTool:
SetScale;
PolygonTool:
DoMeasurementOptions;
FreehandTool:
Calibrate;
ruler:
SetLineWidth;
PlotTool:
DoProfilePlotOptions;
Eraser:
if info <> NoInfo then begin
KillRoi;
SetupUndo;
WhatToUndo := UndoClear;
StopDigitizing;
SelectAll(false);
DoOperation(eraseOp);
end;
LutTool, Wand:
if DensitySlicing then
DisableDensitySlice
else begin
if Info^.Thresholding then
ResetGrayMap;
if OptionKeyDown then
AutoDensitySlice;
EnableDensitySlice;
end;
PickerTool:
if info^.LutMode <> PseudoColor then begin {Switch to pseudocolor mode}
DisableDensitySlice;
UpdateLUT;
CurrentTool := LutTool;
isSelectionTool := false;
InvalRect(ToolRect[CurrentTool]);
end
else
ResetGrayMap;
otherwise
end; {case}
if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) and (CurrentTool <> Wand) then
KillRoi;
if not DoubleClick and (CurrentTool = LineTool) then
KillRoi;
with info^ do
if RoiShowing then
if EqualRect(RoiRect, PicRect) and not isSelectionTool then {if Select All}
KillRoi;
if (CurrentTool = SelectionTool) or (CurrentTool = CrossHairTool) then begin
ValuesMessage := '';
if mCount > 0 then
ShowValues;
end;
RoiMode := MoveMode;
if CurrentTool = LineTool then begin
if Button then
DoPopUpMenusInTools;
if (LoiType = Straight) and (LineWidth <> 1) then begin
LineWidth := 1;
UpdateRoiLineWidth;
ShowLineWidth;
end;
end;
end
else begin
for i := 1 to nLineTypes do begin
r := lines[i];
with r do begin
left := left - 13;
top := top - 2;
right := right + 2;
bottom := bottom + 2;
end;
if i = 1 then
with r do
top := top - 7;
if PtInRect(loc, r) then begin
with lines[i] do
LineWidth := bottom - top;
LineIndex := i;
end;
end;
EraseRect(CheckRect);
InvalRect(CheckRect);
UpdateRoiLineWidth;
end;
end;
procedure ScaleToFitScreen;
var
trect: rect;
ignore: boolean;
begin
with info^ do begin
MoveWindow(wptr, PicLeftBase, PicTopBase, true);
SetRect(trect, 0, 0, ScreenWidth, ScreenHeight);
ScaleImageWindow(trect);
wrect := trect;
SizeWindow(wptr, trect.right, trect.bottom, true);
end;
end;
procedure DoDrag (WhichWindow: WindowPtr; loc: point);
var
WinRect, DragBounds, trect: rect;
kind: integer;
begin
kind := WindowPeek(WhichWindow)^.WindowKind;
if kind = PicKind then begin
if info^.PictureType = ScionType then
exit(DoDrag);
with info^ do begin {Save window location}
GetWindowRect(wptr, trect);
savehloc := trect.left;
savevloc := trect.top;
end;
PicLeft := PicLeftBase;
PicTop := PicTopBase;
end;
DragBounds := ScreenBits.bounds;
DragWindow(WhichWindow, loc, DragBounds);
if (info^.PictureType = FrameGrabberType) or OptionKeyDown then begin
GetWindowRect(WhichWindow, trect);
MoveWindow(WhichWindow, band(trect.left, $fffc), trect.top, true);
end;
if WhichWindow = ValuesWindow then
ShowValues;
if WhichWindow = ResultsWindow then begin
GetWindowRect(WhichWindow, trect);
ResultsTop := trect.top;
ResultsLeft := trect.left;
end;
end;
procedure UpdateMenus;
begin
OptionKeyWasDown := OptionKeyDown;
CurrentKind := CurrentWindow;
UpdateFileMenu;
UpdateEditMenu;
UpdateOptionsMenu;
UpdateTextItems;
UpdateEnhanceMenu;
UpdateAnalysisMenu;
UpdateSpecialMenu;
UpdateStacksMenu;
UpdateWindowsMenu;
end;
function HMGetBalloons: BOOLEAN;
inline
$303C, $0003, $A830;
function BalloonHelp: boolean;
begin
if not System7 then begin
BalloonHelp := false;
exit(BalloonHelp);
end;
BalloonHelp := HMGetBalloons;
end;
procedure DoMouseDown (event: EventRecord);
var
WhichWindow: WindowPtr;
ThePart, ignore, kind: integer;
trect: rect;
begin
ThePart := FindWindow(event.where, WhichWindow);
kind := WindowPeek(WhichWindow)^.WindowKind;
case ThePart of
InDesk:
;
InMenuBar: begin
UpdateMenus;
DoMenuEvent(MenuSelect(event.where));
end;
InSysWindow:
SystemClick(Event, WhichWindow);
InContent: begin
RoiUpdateTime := 0;
if WhichWindow = ToolWindow then begin
if BalloonHelp then
SelectWindow(ToolWindow);
DoMouseDownInTools(event.where);
exit(DoMouseDown);
end;
if WhichWindow = MapWindow then begin
if BalloonHelp then
SelectWindow(MapWindow);
DoMouseDownInMap;
exit(DoMouseDown)
end;
if WhichWindow = LUTWindow then begin
if BalloonHelp then
SelectWindow(LUTWindow);
DoMouseDownInLUT(event);
exit(DoMouseDown)
end;
if WhichWindow = PasteControl then begin
DoMouseDownInPasteControl(event.where);
exit(DoMouseDown)
end;
if WhichWindow = ResultsWindow then begin
DoMouseDownInResults(event.where);
exit(DoMouseDown)
end;
if kind = TextKind then begin
DoMouseDownInText(Event, WhichWindow);
exit(DoMouseDown)
end;
if WhichWindow <> FrontWindow then
SelectWindow(WhichWindow)
else
DoMouseDownInWindow(Event, WhichWindow);
end;
InDrag:
DoDrag(WhichWindow, event.where);
InGrow:
DoGrow(WhichWindow, event);
InGoAway:
if TrackGoAway(WhichWindow, event.where) then
if OptionKeyDown and (kind = PicKind) then
CloseAll
else begin
if WhichWindow <> VideoControl then
StopDigitizing;
ignore := CloseAWindow(WhichWindow);
end;
InZoomIn, InZoomOut:
with info^ do
case WindowState of
NormalWindow: begin
if digitizing then
exit(DoMouseDown);
ScaleToFit;
if ScaleToFitWindow then
ScaleToFitScreen;
end;
TiledSmall, TiledSmallScaled: begin
if WindowState = TiledSmall then begin
ScaleToFitWindow := true;
WindowState := TiledBig;
end
else
WindowState := TiledBigScaled;
savewrect := wrect;
SaveSrcRect := SrcRect;
SaveMagnification := magnification;
GetWindowRect(wptr, trect);
savehloc := trect.left;
savevloc := trect.top;
ScaleToFitScreen;
UpdatePicWindow;
end;
TiledBig: begin
ScaleToFitWindow := false;
WindowState := TiledSmall;
wrect := savewrect;
SrcRect := SaveSrcRect;
magnification := SaveMagnification;
HideWindow(wptr);
SizeWindow(wptr, wrect.right, wrect.bottom, true);
MoveWindow(wptr, savehloc, savevloc, true);
ShowWindow(wptr);
UpdatePicWindow;
magnification := 1.0;
UpdateTitleBar;
end;
TiledBigScaled: begin
WindowState := TiledSmallScaled;
wrect := savewrect;
SrcRect := PicRect;
HideWindow(wptr);
SizeWindow(wptr, wrect.right, wrect.bottom, true);
MoveWindow(wptr, savehloc, savevloc, true);
ShowWindow(wptr);
UpdatePicWindow;
if PicRect.right <> 0 then
magnification := wrect.right / PicRect.right;
UpdateTitleBar;
end;
end; {case WindowState}
end; {case thePart}
end;
procedure NudgeRoi (key: integer);
var
dh, dv: integer;
begin
with info^ do begin
if not RoiShowing then
exit(NudgeRoi);
case key of
LeftArrow: begin
dh := -1;
dv := 0
end;
RightArrow: begin
dh := 1;
dv := 0
end;
UpArrow: begin
dh := 0;
dv := -1
end;
DownArrow: begin
dh := 0;
dv := 1
end;
end;
if OptionKeyDown then begin
if RoiType = RectRoi then
with RoiRect do begin
right := right + dh;
if right < left + 2 then
right := left + 2;
bottom := bottom + dv;
if bottom < top + 2 then
bottom := top + 2;
MakeRegion;
end
else
beep;
end
else begin
OffsetRgn(roiRgn, dh, dv);
RoiRect := roiRgn^^.rgnBBox;
end;
RoiNudged := true;
RoiUpdateTime := 0;
end;
end;
procedure DoKeyDown (event: EventRecord);
var
ch: char;
ich, KeyCode: integer;
begin
Ch := chr(band(Event.message, CharCodeMask));
ich := ord(ch);
{ShowMessage(long2str(ich));}
KeyCode := bsr(band(Event.message, KeyCodeMask), 8);
if BitAnd(Event.modifiers, CmdKey) = CmdKey then begin
UpdateMenus;
if OptionKeyWasDown then begin
case KeyCode of
1:
ch := 'S';
3:
ch := 'F';
5:
ch := 'G';
8:
ch := 'C';
9:
ch := 'V';
13:
ch := 'W';
17:
ch := 'T';
24:
ch := '=';
35:
ch := 'P';
44:
ch := '/';
end;
end;
DoMenuEvent(MenuKey(Ch));
exit(DoKeyDown)
end;
if CurrentWindow = TextKind then begin
DoKeyDownInText(ch);
exit(DoKeyDown)
end;
with info^ do
if (CurrentTool = TextTool) and IsInsertionPoint and (ord(ch) <> FunctionKey) then
DrawCharacter(ch)
else if ch = BackSpace then
DoClear
else if RoiShowing and (ich >= LeftArrow) and (ich <= DownArrow) then
NudgeRoi(ich)
else if (StackInfo <> nil) and (ch in ['<', ',', chr(PageUp), '>', '.', chr(PageDown), chr(HomeKey), chr(EndKey)]) then begin
if ch in ['<', ',', chr(PageUp)] then
ShowNextSlice(PreviousSliceItem)
else if ch in ['>', '.', chr(PageDown)] then
ShowNextSlice(NextSliceItem)
else if (ich = HomeKey) or (ich = EndKey) then
ShowFirstOrLastSlice(ich);
end
else if nMacros > 0 then
RunKeyMacro(ch, KeyCode);
end;
procedure DoActivate (event: EventRecord);
var
WhichWindow: WindowPtr;
Activating, SwitchingWindows, isOK: boolean;
I, kind: integer;
NewInfo: InfoPtr;
begin
WhichWindow := WindowPtr(event.message);
kind := WindowPeek(WhichWindow)^.WindowKind;
Activating := odd(event.modifiers);
case kind of
PicKind: begin
if Activating then begin
NewInfo := pointer(WindowPeek(WhichWindow)^.RefCon);
SwitchingWindows := NewInfo <> Info;
if SwitchingWindows then begin
StopDigitizing;
SaveRoi;
DisableDensitySlice;
end;
Info := NewInfo;
if SwitchingWindows then
ActivateWindow;
Measuring := false;
with info^ do begin
DrawMap;
LoadLUT(cTable);
if digitizing and HighlightSaturatedPixels then
HighlightPixels;
GenerateValues;
if not DensityCalibrated then
DrawLabels('', '', '');
end; {with}
end
else
KillOperation; {Deactivate}
end;
ResultsKind:
UpdateResultsWindow;
TextKind:
ActivateTextWindow(WhichWindow, Activating);
otherwise
end; {case}
if not activating then begin
WhichWindow := FrontWindow;
if WhichWindow <> nil then begin
kind := WindowPeek(WhichWindow)^.WindowKind;
if kind < 0 then
ConvertClipboard; {DA has become active}
end;
end;
end;
procedure DoUpdate (event: EventRecord);
var
WhichWindow: WindowPtr;
SaveInfo: InfoPtr;
kind: integer;
begin
WhichWindow := WindowPtr(event.message);
kind := WindowPeek(WhichWindow)^.WindowKind;
BeginUpdate(WhichWindow);
case kind of
Pickind: begin
SaveInfo := info;
Info := pointer(WindowPeek(WhichWindow)^.RefCon);
if not digitizing then begin
UpdatePicWindow;
DrawMyGrowIcon(info^.wptr);
end;
info := SaveInfo;
end;
ToolKind:
DrawTools;
MapKind:
DrawMap;
LUTKind:
DrawLUT;
ValuesKind: begin
DrawLabels('', '', '');
if (mCount > 0) or (ValuesMessage <> '') then
ShowValues;
end;
HistoKind:
DrawHistogram;
ProfilePlotKind, CalibrationPlotKind:
UpdatePlotWindow;
ResultsKind:
UpdateResultsWindow;
PasteControlKind:
DrawPasteControl;
TextKind:
UpdateTextWindow(WhichWindow);
end;
EndUpdate(WhichWindow);
end;
procedure DoDiskInsert (event: EventRecord);
{ Process disk insertion event, check for damaged or uninitialized disks. }
var
p: point;
intjunk: integer;
begin
if (HiWord(event.message) <> NoErr) then begin
DiLoad;
SetPt(p, 100, 80);
intjunk := DiBadMount(p, event.message);
DiUnload;
end;
end;
procedure DoDialogEvent (event: EventRecord);
{Handles modeless dialog box events}
var
isItemHit: boolean;
theDialog: DialogPtr;
ItemHit: integer;
ch: char;
begin
if (Event.what = KeyDown) and (BitAnd(Event.modifiers, CmdKey) = CmdKey) then begin
UpdateMenus;
ch := chr(band(Event.message, CharCodeMask));
DoMenuEvent(MenuKey(ch));
exit(DoDialogEvent);
end;
isItemHit := DialogSelect(event, theDialog, ItemHit);
if isItemHit and (theDialog = VideoControl) then
DoVideoControl(ItemHit);
end;
function HandleEvents: boolean;
const
mousemovedmessage = $FA;
SuspendResumeMessage = 1;
ResumeMask = 1;
var
Event: EventRecord;
result: boolean;
theDialog: DialogPtr;
ItemHit: integer;
SleepTicks: LongInt;
okay: boolean;
begin
if Digitizing then
SleepTicks := 0
else
SleepTicks := 2;
if WaitNextEvent(EveryEvent, Event, SleepTicks, nil) then begin
if isDialogEvent(event) then
DoDialogEvent(event)
else
case Event.what of
KeyDown, AutoKey:
DoKeyDown(Event);
MouseDown:
DoMouseDown(Event);
ActivateEvt:
DoActivate(Event);
DiskEvt:
DoDiskInsert(Event);
UpdateEvt:
DoUpdate(Event);
app4Evt:
case BSR(event.message, 24) of
MouseMovedMessage:
;
SuspendResumeMessage:
if BAND(event.message, ResumeMask) <> 0 then begin{Resume event}
if SwitchLUTOnSuspend and (WhatToUndo = UndoLUT) then begin
UndoLUTChange;
WhatToUndo := NothingToUndo;
end
else
LoadLUT(info^.ctable);
end
else begin {Suspend event}
KillOperation;
ConvertClipboard;
if SwitchLUTOnSuspend then begin
SetupLUTUndo;
okay := LoadCLUTResource(AppleDefaultCLUT);
end;
end;
end;
otherwise {Do nothing}
end; {case}
HandleEvents := true
end
else
HandleEvents := false;
end;
procedure ShowInsertionPoint;
var
tRect: rect;
Loc: point;
height, imag: integer;
begin
if (not isInsertionPoint) or (info = NoInfo) then
exit(ShowInsertionPoint);
if CurrentWindow <> PicKind then
exit(ShowInsertionPoint);
if (TickCount mod (BlinkTime * 2)) < BlinkTime then
exit(ShowInsertionPoint);
Loc := InsertionPoint;
OffscreenToScreen(loc);
with info^, tRect do begin
SetPort(wptr);
imag := trunc(magnification + 0.5);
height := CurrentSize * imag;
height := height - height div 4;
left := loc.h;
bottom := loc.v - imag + 1;
top := bottom - height;
right := left + 1;
PenNormal;
PenSize(imag, imag);
PenMode(PatXor);
FrameRect(tRect);
ticks := TickCount + 3;
repeat
until TickCount > ticks;
FrameRect(tRect);
end;
end;
procedure UndoRoi;
var
SrcPtr, DstPtr: ptr;
offset, ByteCount, tTop, tBottom: LongInt;
tRect: rect;
begin
with info^ do begin
if PixMapSize <> CurrentUndoSize then
exit(UndoRoi);
tRect := RoiRect;
if RoiType = LineRoi then
InsetRect(tRect, -RoiHandleSize, -RoiHandleSize);
with tRect do begin
tTop := top;
tBottom := bottom;
if tTop < 0 then
tTop := 0;
if tTop > PicRect.bottom then
tTop := PicRect.bottom;
if tBottom < 0 then
tBottom := 0;
if tBottom > PicRect.bottom then
tBottom := PicRect.bottom;
end;
offset := tTop * BytesPerRow;
if offset < 0 then
offset := 0;
SrcPtr := ptr(ord4(UndoBuf) + offset);
DstPtr := ptr(ord4(PicBaseAddr) + offset);
ByteCount := (tBottom - tTop) * BytesPerRow;
BlockMove(SrcPtr, DstPtr, ByteCount);
end;
end;
procedure GetLineHandles (var LeftHandle, MiddleHandle, RightHandle: rect);
var
offset1, offset2, xcenter, ycenter, x1, y1, x2, y2: integer;
rx1, ry1, rx2, ry2: real;
begin
offset1 := RoiHandleSize div 2;
offset2 := offset1 + 1;
GetLoi(rx1, ry1, rx2, ry2);
x1 := trunc(rx1);
y1 := trunc(ry1);
x2 := trunc(rx2);
y2 := trunc(ry2);
SetRect(LeftHandle, x1 - offset1, y1 - offset1, x1 + offset2, y1 + offset2);
with info^.RoiRect do begin
xcenter := left + (right - left) div 2;
ycenter := top + (bottom - top) div 2;
end;
SetRect(MiddleHandle, xcenter - offset1, ycenter - offset1, xcenter + offset2, ycenter + offset2);
SetRect(RightHandle, x2 - offset1, y2 - offset1, x2 + offset2, y2 + offset2);
end;
procedure DrawROI;
var
tRect: rect;
RoiHandle, LeftHandle, MiddleHandle, RightHandle: rect;
psize: integer;
StartTicks: LongInt;
begin
with Info^ do begin
StartTicks := TickCount;
if OpPending then
DoOperation(CurrentOp);
SetPort(GrafPtr(Info^.osPort));
PenNormal;
if ScaleToFitWindow then
if (magnification < 1.0) and (magnification <> 0.0) then begin
psize := round(1.0 / magnification + 1.5);
PenSize(psize, psize);
end;
if not ((MouseState = DownInRoi) and OpPending) then
if PixMapSize <= UndoBufSize then begin
pmForeColor(BlackIndex);
pmBackColor(WhiteIndex);
case RoiType of
RectRoi:
with RoiRect do begin
SetRect(RoiHandle, right - RoiHandleSize, bottom - RoiHandleSize, right, bottom);
if ((right - left) > RoiHandleSize) and ((bottom - top) > RoiHandleSize) then
PaintRect(RoiHandle);
end;
LineRoi:
if Magnification <= 2.0 then begin
GetLineHandles(LeftHandle, MiddleHandle, RightHandle);
PaintRect(LeftHandle);
if LineWidth < 4 then
PaintRect(MiddleHandle);
PaintRect(RightHandle);
pmForeColor(WhiteIndex);
FrameRect(LeftHandle);
if LineWidth < 4 then
FrameRect(MiddleHandle);
FrameRect(RightHandle);
pmForeColor(BlackIndex);
end;
otherwise
end;
PatIndex := (PatIndex + 1) mod 8;
PenPat(pat[PatIndex]);
FrameRgn(roiRgn);
pmForeColor(ForegroundIndex);
pmBackColor(BackgroundIndex);
end;
if PixMapSize > UndoBufSize then begin
if magnification < 1.0 then
PenSize(2, 2);
PatIndex := (PatIndex + 1) mod 8;
PenPat(pat[PatIndex]);
PenMode(PatXor);
FrameRgn(roiRgn);
if MouseState = DownInRoi then begin
UnionRect(RoiRect, OldRoiRect, tRect);
UpdateScreen(tRect);
end
else
UpdateScreen(RoiRect);
FrameRgn(roiRgn);
end
else begin
tRect := RoiRect;
if MouseState = DownInRoi then
UnionRect(RoiRect, OldRoiRect, tRect)
else if RoiNudged then begin
tRect := RoiRect;
RoiNudged := false;
end;
if RoiType = LineRoi then
InsetRect(tRect, -RoiHandleSize * 2, -RoiHandleSize * 2)
else
InsetRect(tRect, -2, -2);
UpdateScreen(tRect);
UndoRoi; {Erase offscreen ROI}
end;
RoiUpdateTime := TickCount - StartTicks;
end; {with}
end;
procedure MoveLineEndPoint (osloc: point);
var
deltax, deltay: real;
begin
with info^, osloc, info^.RoiRect do begin
if h < 0 then
h := 0;
if h > PicRect.right then
h := PicRect.right;
if v < 0 then
v := 0;
if v > PicRect.bottom then
v := PicRect.bottom;
if RoiMode = LeftEndMode then begin
LX1 := h;
LY1 := v;
LX2 := left + LX2;
LY2 := top + LY2;
end
else begin
LX2 := h;
LY2 := v;
LX1 := left + LX1;
LY1 := top + LY1;
end;
if ShiftKeyDown then begin
deltax := LX2 - LX1;
deltay := LY2 - LY1;
if abs(deltax) > abs(deltay) then begin
if RoiMode = LeftEndMode then
LY2 := LY1
else
LY1 := LY2
end
else begin
if RoiMode = LeftEndMode then
LX2 := LX1
else
LX1 := LX2
end;
end; {if ShiftKeyDown}
MakeRegion;
osMouseDownLoc := osloc;
RoiUpdateTime := 0;
Show3Values(h, v, MyGetPixel(h, v));
end;
end;
procedure MoveRoi (osloc: point);
var
dh, dv: integer;
begin
with info^, info^.RoiRect, osloc do begin
dh := h - osMouseDownLoc.h;
dv := v - osMouseDownLoc.v;
OldRoiRect := RoiRect;
if RoiType = LineRoi then
if (RoiMode = LeftEndMode) or (RoiMode = RightEndMode) then begin
MoveLineEndPoint(osloc);
exit(MoveRoi);
end;
if RoiMode = MoveMode then begin
if RoiMovementState = Constrained then begin
if dv <> 0 then
RoiMovementState := ConstrainedV
else if dh <> 0 then
RoiMovementState := ConstrainedH
end;
if RoiMovementState = ConstrainedH then
dv := 0
else if RoiMovementState = ConstrainedV then
dh := 0;
if not OpPending then begin
if left + dh < 0 then
dh := -left;
if top + dv < 0 then
dv := -top;
end;
end;
if not OpPending then begin
if right + dh > PicRect.right then
dh := PicRect.right - right;
if bottom + dv > PicRect.bottom then
dv := PicRect.bottom - bottom;
end;
if RoiMode = StretchMode then begin
measuring := false;
DrawLabels('Width:', 'Height:', '');
if h > left then begin
right := right + dh;
if right < (left + 1) then
right := left + 1;
if (right - h) > 5 then
right := h + 2;
end
else
right := left + 1;
if v > top then begin
bottom := bottom + dv;
if bottom < (top + 1) then
bottom := top + 1;
if (bottom - v) > 5 then
bottom := v + 2;
end
else
bottom := top + 1;
Show3Values(right - left, bottom - top, -1);
MakeRegion;
end
else begin
OffsetRgn(roiRgn, dh, dv);
Show3Values(left, top, MyGetPixel(left, top));
end;
RoiRect := roiRgn^^.rgnBBox;
osMouseDownLoc := osloc;
RoiUpdateTime := 0; {Forces ROI outline to be redrawn}
end; {with Info}
end;
procedure ShowHistogramValues (GrayLevel: LongInt);
var
hstart, vstart, ivalue: integer;
begin
hstart := ValuesHStart;
vstart := ValuesVStart;
SetPort(ValuesWindow);
TextSize(9);
TextFont(Monaco);
TextMode(SrcCopy);
MoveTo(xValueLoc, vstart);
with info^ do
if DensityCalibrated then begin
if InvertingCalibrationFunction then
DrawReal(cvalue[255 - GrayLevel], 8, 2)
else
DrawReal(cvalue[GrayLevel], 8, 2);
DrawString(' (');
DrawLong(GrayLevel);
DrawString(' )');
end
else
DrawLong(GrayLevel);
DrawString(' ');
MoveTo(yValueLoc, vstart + 10);
if InvertingCalibrationFunction then
DrawLong(histogram[255 - GrayLevel])
else
DrawLong(histogram[GrayLevel]);
DrawString(' ');
end;
procedure DoPlotCursor (loc: point; kind: integer);
var
xscale, angle: extended;
xvalue, xinc, yinc: integer;
pt: point;
begin
DrawLabels('X:', 'Y:', '');
SetCursor(ToolCursor[SelectionTool]);
SetPort(PlotWindow);
GlobalToLocal(loc);
xscale := PlotCount / (PlotWidth - PlotRightMargin - PlotLeftMargin);
xvalue := trunc((loc.h - PlotLeftMargin) * xscale);
if (xvalue < 0) or (xvalue >= PlotCount) then
exit(DoPlotCursor);
Show2PlotValues(xvalue, PlotData^[xvalue]);
if (kind = CalibrationPlotKind) or (info^.RoiType <> LineRoi) then
exit(DoPlotCursor);
if button and (info <> NoInfo) then
with loc do begin
SetPort(info^.wptr);
PenMode(PatXor);
PenSize(1, 1);
angle := (PlotAngle / 180.0) * pi;
xinc := round(cos(angle) * xvalue);
yinc := round(-sin(angle) * xvalue);
h := PlotStart.h + xinc;
v := PlotStart.v + yinc;
OffscreenToScreen(loc);
MoveTo(h - 7, v);
LineTo(h + 7, v);
MoveTo(h, v - 7);
LineTo(h, v + 7);
wait(2);
MoveTo(h - 7, v);
LineTo(h + 7, v);
MoveTo(h, v - 7);
LineTo(h, v + 7);
end;
end;
procedure SelectCursor;
var
loc, osloc, gloc: point;
where, kind, i, color, x, y, margin: integer;
WhichWindow: WindowPtr;
MouseInRoi: boolean;
fwptr: WindowPtr;
CalValue: extended;
RoiStretchHandle, LeftHandle, MiddleHandle, RightHandle: rect;
MovingRoi: boolean;
pvalue: integer;
begin
if PasteControl <> nil then begin
fwptr := FrontWindow;
if fwptr <> nil then
if WindowPeek(fwptr)^.WindowKind <> PasteControlKind then
BringToFront(PasteControl);
end;
SetPort(ScreenPort);
GetMouse(gloc);
loc := gloc;
where := FindWindow(gloc, WhichWindow);
if WhichWindow = nil then begin
InitCursor;
exit(SelectCursor)
end;
kind := WindowPeek(WhichWindow)^.WindowKind;
if kind < 0 then
exit(SelectCursor); {System Window}
if where <> InContent then begin
InitCursor;
exit(SelectCursor)
end;
case kind of
PicKind: begin
if Info = NoInfo then begin
InitCursor;
exit(SelectCursor)
end;
SetPort(info^.wptr);
GlobalToLocal(loc);
osloc := loc;
ScreenToOffscreen(osloc);
MovingRoi := false;
with info^ do begin
SelectionMode := NewSelection;
if RoiShowing and ((isSelectionTool) or (CurrentTool = Wand)) and (currentTool <> LineTool) then begin
if OptionKeyDown then
SelectionMode := SubSelection
else if ControlKeyDown or (ShiftKeyDown and (CurrentTool <> OvalSelectionTool) and (CurrentTool <> SelectionTool)) then
SelectionMode := AddSelection;
end;
if RoiShowing and (SelectionMode = NewSelection) then begin
MouseInRoi := PtInRgn(osloc, roiRgn);
if RoiType = LineRoi then begin
GetLineHandles(LeftHandle, MiddleHandle, RightHandle);
if magnification <= 2.0 then begin
InsetRect(LeftHandle, -2, -2);
InsetRect(MiddleHandle, -2, -2);
InsetRect(RightHandle, -2, -2);
end;
MouseInRoi := MouseInRoi or PtInRect(osloc, LeftHandle) or MouseInRoi or PtInRect(osloc, MiddleHandle) or MouseInRoi or PtInRect(osloc, RightHandle);
end;
end
else
MouseInRoi := false
end; {with}
if MouseInRoi or (MouseState = DownInRoi) then begin
if MouseState = NotInRoi then
MouseState := InRoi;
InitCursor;
if button then begin
if MouseState = InRoi then begin
if OpPending and (CurrentOp <> PasteOp) then
SetupUndo;
MouseState := DownInRoi;
osMouseDownLoc := osloc;
with info^ do
case RoiType of
RectRoi: begin
if magnification > 1.0 then
margin := 0
else
margin := 2;
with RoiRect do
SetRect(RoiStretchHandle, right - RoiHandleSize - margin, bottom - RoiHandleSize - margin, right, bottom);
if PtInRect(osloc, RoiStretchHandle) then
RoiMode := StretchMode
else
RoiMode := MoveMode;
end;
LineRoi:
if PtInRect(osloc, LeftHandle) then
RoiMode := LeftEndMode
else if PtInRect(osloc, RightHandle) then
RoiMode := RightEndMode
else
RoiMode := MoveMode;
otherwise
end; {case}
if ShiftKeyDown then
RoiMovementState := Constrained
else
RoiMovementState := Unconstrained;
end;
MoveRoi(osloc);
MovingRoi := true;
end
else
MouseState := InRoi
end
else begin
MouseState := NotInRoi;
if SpaceBarDown and (CurrentTool <> TextTool) then
SetCursor(ToolCursor[Grabber])
else if (SelectionMode = AddSelection) and (CurrentTool = Wand) then
SetCursor(WandPlusCursor)
else if (SelectionMode = SubSelection) and (CurrentTool = Wand) then
SetCursor(WandMinusCursor)
else if SelectionMode = AddSelection then
SetCursor(CrossPlusCursor)
else if SelectionMode = SubSelection then
SetCursor(CrossMinusCursor)
else if (CurrentTool = MagnifyingGlass) and OptionKeyDown then
SetCursor(GlassMinusCursor)
else
SetCursor(ToolCursor[CurrentTool]);
end;
if not MovingRoi then begin
if CurrentTool = PickerTool then
DrawLabels('X:', 'Y:', 'RGB:')
else
DrawLabels('X:', 'Y:', 'Value:');
with osloc do begin
if Digitizing then
pvalue := GetFGPixel(h, v)
else
pvalue := MyGetPixel(h, v);
Show3Values(h, v, pvalue);
end;
end;
end;
HistoKind: begin
DrawLabels('Level:', 'Count:', '');
SetCursor(ToolCursor[SelectionTool]);
SetPort(HistoWindow);
GlobalToLocal(loc);
ShowHistogramValues(loc.h);
end;
ProfilePlotKind, CalibrationPlotKind:
DoPlotCursor(loc, kind);
LUTKind: begin
if info^.DensityCalibrated then
DrawLabels('Index:', 'Value:', ' RGB:')
else
DrawLabels('Index:', ' RGB:', '');
SetPort(LUTWindow);
GlobalToLocal(loc);
if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin
if loc.v < 256 then
SetCursor(LUTCursor)
else
InitCursor
end
else
SetCursor(PickerCursor);
if loc.v < 256 then begin
ShowRGBValues(loc.v);
end
else begin
color := 0;
for i := 1 to nExtraColors + 2 do
if PtInRect(loc, ExtraColorsRect[i]) then
Color := ExtraColorsEntry[i];
ShowRGBValues(color);
end;
end;
MapKind:
if OptionKeyDown then
SetCursor(ToolCursor[SelectionTool])
else
SetCursor(gmCursor);
TextKind: begin
TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
if TextInfo <> nil then
with TextInfo^ do begin
SetPort(TextWindowPtr);
GlobalToLocal(loc);
TEIdle(TextTE);
with TextWindowPtr^.portRect do begin
if (loc.h < (right - ScrollBarWidth)) and (loc.v < (bottom - ScrollBarWidth)) then
SetCursor(ToolCursor[TextTool])
else
InitCursor;
end;
end;
end;
otherwise
InitCursor;
end; {case}
end;
procedure CloseAll;
var
i, j, result: integer;
WPeek, NextWPeek: WindowPeek;
ignore: boolean;
begin
InitCursor;
WPeek := WindowPeek(FrontWindow);
StopDigitizing;
while wpeek <> nil do begin
NextWPeek := WPeek^.NextWindow;
case wPeek^.WindowKind of
PicKind: begin
Info := pointer(WPeek^.RefCon);
result := CloseAWindow(info^.wptr);
if not CommandPeriod then
for j := 1 to 2 do
ignore := HandleEvents;
if result = cancel then begin
ActivateWindow;
finished := false;
exit(CloseAll)
end;
end;
TextKind: begin
result := CloseAWindow(WindowPtr(wPeek));
if result = cancel then begin
finished := false;
exit(CloseAll)
end;
end;
otherwise
;
end; {case}
wpeek := NextWPeek;
end;
end;
procedure DoStartup;
{Process Finder startup information}
var
message, ndocs, err, i, j: integer;
DocInfo: AppFile;
DefaultPalette, OpenedOK: boolean;
PaletteName, OutlineName: str255;
PaletteFile, OutlineFile: boolean;
ignore, PrintDocs: boolean;
procedure PrintDocument;
var
i: integer;
begin
WhatToPrint := PrintImage;
if PrintOptionsSet then
Print(false)
else begin
Print(true);
PrintOptionsSet := true
end;
DoClose;
for i := 1 to 10 do
ignore := HandleEvents;
end;
begin
for j := 1 to 10 do
ignore := HandleEvents;
PrintOptionsSet := false;
PaletteFile := false;
OutlineFile := false;
CountAppFiles(message, ndocs);
PrintDocs := message = appPrint;
if ndocs >= 1 then
for i := 1 to ndocs do begin
GetAppFiles(i, DocInfo);
with DocInfo do begin
if ftype = 'ICOL' then begin
PaletteFile := true;
PaletteName := docinfo.fname;
ClrAppFiles(i)
end;
if fType = 'IPIC' then begin
WhatToOpen := OpenImage;
OpenedOK := OpenFile(fName, vRefNum);
for j := 1 to 10 do
ignore := HandleEvents;
ClrAppFiles(i);
if not OpenedOK then
exit(DoStartup);
if PrintDocs then
PrintDocument;
end;
if fType = 'TIFF' then begin
WhatToOpen := OpenTIFF;
OpenedOK := OpenFile(fName, vRefNum);
for j := 1 to 10 do
ignore := HandleEvents;
ClrAppFiles(i);
if not OpenedOK then
exit(DoStartup);
if PrintDocs then
PrintDocument;
end;
if fType = 'PICT' then begin
OpenedOK := OpenPICT(fName, vRefNum, false);
for j := 1 to 10 do
ignore := HandleEvents;
ClrAppFiles(i);
if not OpenedOK then
exit(DoStartup);
if PrintDocs then
PrintDocument;
end;
if fType = 'PICS' then begin
OpenedOK := OpenPICS(fName, vRefNum);
for j := 1 to 10 do
ignore := HandleEvents;
ClrAppFiles(i);
if not OpenedOK then
exit(DoStartup);
end;
if ftype = 'Iout' then begin
OutlineFile := true;
OutlineName := docinfo.fname;
ClrAppFiles(i)
end;
if fType = 'TEXT' then begin
OpenedOK := OpenTextFile(fName, vRefNum);
ClrAppFiles(i);
if not OpenedOK then
exit(DoStartup);
end;
end; {with}
end;
if PaletteFile then
OpenColorTable(PaletteName, DocInfo.vRefNum);
if OutlineFile then
OpenOutline(OutlineName, DocInfo.vRefNum);
end;
procedure LoadDefaultMacros;
{Looks for a text file named "Image Macros" in the same folder as}
{Image, and, if found, loads the macros contained in it.}
var
err: OSErr;
LaunchRefNum: integer;
FinderInfo: FInfo;
id: LongInt;
begin
err := GetVol(nil, LaunchRefNum);
if err = noerr then
err := GetFInfo('Image Macros', LaunchRefNum, FinderInfo);
if err = NoErr then begin
LoadMacrosFromFile('Image Macros', LaunchRefNum);
UnloadSeg(@LoadMacros);
end;
end;
procedure Shutdown;
var
AlertID: integer;
begin
if (UnsavedResults and (mCount > 10)) or (UnsavedResults and (ResultsWindow <> nil)) then begin
InitCursor;
AlertID := alert(500, nil);
if AlertID = CancelResetID then begin
finished := false;
exit(Shutdown)
end;
end;
CloseAll;
if finished then
ConvertClipboard;
end;
begin
Init;
{InitUserMacros;}
SetupMenus;
GetSettings;
AllocateBuffers;
AllocateArrays;
ConvertSystemClipboard;
DoStartup;
LoadDefaultMacros;
FindPlugIns;
UnloadSeg(@Init);
{InitUser;}
repeat
if not HandleEvents then
if info^.RoiShowing and (RoiUpdateTime < 30) then
DrawRoi;
ShowInsertionPoint;
SelectCursor;
if Digitizing then begin
CaptureAndDisplayFrame;
if ContinuousHistogram then
ShowContinuousHistogram;
end;
if Finished then
Shutdown;
until finished;
CloseSerialPorts;
isOK := LoadCLUTResource(AppleDefaultCLUT);
RestoreScreen; {Force Finder to redraw color icons}
{FinalUserMacros;}
end.
